package OliveFeed;

=head1 NAME

OliveFeed - Feed handling driver code

=head1 DESCRIPTION

This module contains the code which drives the processing of RSS feeds
for Olive. It does not handle actually fetching the feeds (see
L<OliveHTTP>), or parsing the feeds once they are downloaded (see
L<OliveXML>).

=head1 SUBROUTINES

Exported: L</feedpoll>, L</storefeed>

Unexported: L</forcefetch>, L</getfeed>, L</prunefeed>, L</sourcefeed>

=cut

require Exporter;
use warnings;
use strict;
use Digest::MD5 qw( md5_hex );
use OliveHTTP;
use OliveMisc;
use OliveStory;
use OliveXML;

our @ISA       = qw(Exporter);
our @EXPORT    = qw( &feedpoll &storefeed );

#-------------------------------------------------------------

sub feedpoll {
    my $cui = shift;
    my $c  = $cui->userdata->{c};
    my $d  = $cui->userdata->{dbh};
    my $l  = $cui->userdata->{log};
    my $w  = $cui->userdata->{wins};
    my $t  = time();
    my $i  = 0;

    $l->log( level => "info", message => ">> Polling feeds" );

    # setup for statusline output
    my @lt   = localtime($t);
    my $when = sprintf("%02d:%02d",$lt[2],$lt[1]);
    $cui->userdata->{pwhen} = $when unless (defined $cui->userdata->{pwhen});

    # tune sqlite for speed
    db_fastmode($d);

    # walk through feeds, checking delta time against ttl
    foreach my $nick (keys %{$c->{feeds}}) {
        if ($c->{feeds}{$nick}{dormant}) {
            $l->log( level => "info", message => "$nick: Skipping dormant feed" );
            next;
        }
        my $ttl   = $c->{feeds}{$nick}{ttl};
        my $last  = $c->{feeds}{$nick}{last};

        my $delta = $t - $last;
        if ($delta > $ttl) {
            $l->log( level => "info", message => "$nick: TTL expired; fetching" );
            my $frc = fetchfeed($cui,$nick);
            if ($frc == 200) {
                $cui->userdata->{polled}{$nick} = 1;
                $l->log( level => "info", message => "$nick: Fetch successful; parsing..." );
                sourcefeed($cui,$nick);
                $i++;
            } else {
                $l->log( level => "info", message => "$nick: No fetch" );
            }
        } else {
            $l->log( level => "info", message => "$nick: TTL not expired ($delta/$ttl s)" );
        }
    }
    
    # mark new but read stories as old
    my ($read) = $d->selectrow_array("SELECT count(id) FROM stories WHERE new = 1 AND read = 1");
    if ($read) {
        $l->log( level => "info", message => ">> Flagging $read stories as old" );
        $d->do("UPDATE stories SET new = 0 WHERE new = 1 AND read = 1");
    }

    # flush changes to db and restore safe-working settings
    db_safemode($d);

    # build polling data string for status line and update
    my $j = keys %{$cui->userdata->{polled}};
    $cui->userdata->{poll}  = "[P: $i \@ $when";
    $cui->userdata->{poll} .= " | $j since ".$cui->userdata->{pwhen} if ($j);
    $cui->userdata->{poll} .= ']';
    $w->{news}{ftr1}->text(' ' x $w->{dim}[0]);
    $w->{news}{ftr1}->draw;

    $l->log( level => "info", message => ">> Poll complete" );
}

#-------------------------------------------------------------

sub forcefetch {
    my $cui = shift;
    my $c = $cui->userdata->{c};

    my $i = 0;
    foreach my $nick (keys %{$c->{feeds}}) {
        next if $c->{feeds}{$nick}{dormant}; # skip dormant feeds
        if ($c->{feeds}{$nick}{force}) {
            fetchfeed($cui,$nick,1);
            sourcefeed($cui,$nick);
            $i++;
        }
    }
    return $i;    
}

#-------------------------------------------------------------

sub getfeed {
    my $cui = shift;
    my $feed = '';
    my $feedname = '';

    if($cui->getobj('feed')) {
        $cui->getobj('feed')->focus;
        $cui->getobj('feed')->draw;
        return;
    }

    my $fw = $cui->add('feed', 'Window',
                         -border   => 1,
                         -bfg      => 'blue',
                         -title    => 'Add New Feed',
                         -height   => 13,
                         -width    => 60,
                         -centered => 1,
                        );
    $fw->{l1} = $fw->add(undef, 'Label',
                         -text => "Location:",
                         -x    => 1,
                         -y    => 1,
        );
    $fw->{l2} = $fw->add(undef, 'Label',
                         -text => "Nickname:",
                         -x    => 1,
                         -y    => 3,
        );
    $fw->{loc} = $fw->add('fwlo', 'TextEntry',
                          -x       => 11,
                          -y       => 1,
                          -width   => 46,
                          -reverse => 1,
                          -onchange  => sub { $feed = $fw->{loc}->get },
        );
    $fw->{nic} = $fw->add('fwnn', 'TextEntry',
                          -x         => 11,
                          -y         => 3,
                          -width     => 17,
                          -maxlength => 16,
                          -reverse   => 1,
                          -onchange  => sub { $feedname = $fw->{nic}->get },
        );
    $fw->{ffl} = $fw->add('fwfl', 'Listbox',
                          -values => [ 1 ],
                          -labels => { 1  => 'Flag this feed' },
                          -multi    => 1,
                          -height   => 1,
                          -width    => 27,
                          -y        => 5,
                          -x        => 11,
        );
    $fw->{frc} = $fw->add('fwfr', 'Listbox',
                          -values => [ 1 ],
                          -labels => { 1  => 'Force-poll this feed' },
                          -multi    => 1,
                          -height   => 2,
                          -width    => 27,
                          -y        => 7,
                          -x        => 11,
        );
    $fw->{okb} = $fw->add('fwok', 'Buttonbox',
                        -y       => -2,
                        -x       => 40,
                        -buttons => [ { -label   => '< OK >',
                                        -value   => 1,
                                        -onpress => sub { my $rc =
                                                              storefeed($cui,
                                                                        $feed,
                                                                        $feedname,
                                                                        $fw->{frc}->get || 0,
                                                                        $fw->{ffl}->get || 0,);
                                                          return if $rc;
                                                          $fw->loose_focus;
                                                          $cui->enable_timer('clock');
                                                          $cui->delete('feed');
                                                          feedpoll($cui); 
                                                          refreshlist($cui) },
                                      },
                                      { -label   => '< Cancel >',
                                        -value   => 0,
                                        -onpress => sub { $fw->loose_focus;
                                                          $cui->enable_timer('clock');
                                                          $cui->delete('feed');
                                                          $cui->draw },
                                      },

                        ],
        );
    $cui->disable_timer('clock');
    $fw->draw;
    $fw->{loc}->focus;
}

#-------------------------------------------------------------

=head2 prunefeed

Remove stale stories from the story database

    Arguments:   Hashref of MD5 digests
                 DBD::SQLite database handle
                 Nick of the current feed

    Returns:     Nothing.

    Called from: L</sourcefeed>

    Calls:       Nothing

First, the id and md5 fields are selected from the story database for
every unstarred story in the current feed.

This data is iterated over. If a story is starred, it is skipped and
stays in the db. If the MD5 digest of the story being examined is
found in the hash passed as an argument, then that story is still in
the feed, and a flag is set. If the flag is not set, the story is
marked for deletion by having its id added to a hash.

After all stories have been checked, the deletions hash is iterated
over to remove stories from the database which no longer appear in the
feed.

=cut

sub prunefeed {
    my ($md5s,$cui,$nick) = @_;
    my $d = $cui->userdata->{dbh};
    my $l = $cui->userdata->{log};
    my $i = 0;
    my %delete = ();

    my $statement = "SELECT id,md5 FROM stories WHERE nick = '$nick' AND star = 0";
    my $sth = $d->prepare($statement);
    $sth->execute;

    while (my $q = $sth->fetchrow_arrayref) {
        my $keep = 0;
        foreach my $md5 (keys %{$md5s}) {
            $keep = 1 if ($md5 eq $q->[1]);
        }
        $delete{$q->[0]} = 1 unless $keep;
    }

    foreach my $id (keys %delete) {
        $d->do("DELETE FROM stories WHERE id = $id");
        $d->do("DELETE FROM links WHERE sid = $id");
        $i++;
    }
    $l->log( level => "info", message => "$nick: $i stories fell off feed" ) if $i;

}

#-------------------------------------------------------------

sub sourcefeed {
    my ($cui,$nick) = @_;
    my $c = $cui->userdata->{c};
    my $w = $cui->userdata->{wins};

    # set status area
    my $disp= $c->{feeds}{$nick}{disp};
    my $msg = "Parsing $disp...";
    $w->{news}{ftr1}->text($msg . ' ' x ($w->{dim}[0] - length($msg)));
    $w->{news}{ftr1}->draw;

    # process feed
    my ($data,$md5s) = parsexml($cui,$nick);

    # yank expired stories from the db
    $msg = "Pruning expired stories from ".$c->{feeds}{$nick}{disp}."...";
    $w->{news}{ftr1}->text($msg . ' ' x ($w->{dim}[0] - length($msg)));
    $w->{news}{ftr1}->draw;
    prunefeed($md5s,$cui,$nick) if (ref $md5s eq 'HASH');

    # set (possibly new) ttl and title
    $c->{feeds}{$nick}{ttl} = $data->{ttl};
    $c->{feeds}{$nick}{title} = $data->{title};
    $c->write;

    # clear status area
    $w->{news}{ftr1}->text(' ' x $w->{dim}[0]);
    $w->{news}{ftr1}->draw;
}

#-------------------------------------------------------------

sub storefeed {
    my ($cui,$feed,$disp,$force,$dormant,$flag,$nick) = @_;
    my $c  = $cui->userdata->{c};
    my $ua = $cui->userdata->{ua};

    # check for null data
    if ($feed eq '' or $disp eq '') {
        errorbox($cui,"Location and Nickname must both have values for feeds to be saved.");
        return 1;
    }

    # trim whitespace
    $feed =~ s/^\s+//;
    $feed =~ s/\s+$//;
    $disp =~ s/^\s+//;
    $disp =~ s/\s+$//;

    # save original nick for display and sanitize
    unless ($nick) {
        $nick = $disp;
        $nick =~ s/\s/_/g;
        $nick =~ s/\W//g;
        $nick = md5_hex($disp) if ($nick eq '');
        $nick = lc($nick);

        # check for dupe nicks
        if (defined $c->{feeds}{$nick}) {
            errorbox($cui,"There is already a feed with that nick.");
            return 1;
        }        
    }

    # check for dupe feeds
    foreach my $f (keys %{$c->{feeds}}) {
        if ( ($f ne $nick) && ($feed eq $c->{feeds}{$f}{feed}) ) {
            errorbox($cui,"There is already a nick with that URI: $f");
            return 1;
        }
    }

    # poke it over the network to see if it exists (unless dormant)
    unless ($dormant) {
        my $rc = $ua->head($feed);
        unless ($rc->is_success) {
            my $error = $rc->status_line;
            errorbox($cui,"There was a network problem:\n$error");
            return 1;
        }
    }

    # everything looks okay. store it.
    $force = 0 unless (defined $force);
    $c->{feeds}{$nick}{feed}    = $feed;
    $c->{feeds}{$nick}{disp}    = $disp;
    $c->{feeds}{$nick}{flag}    = $flag;
    $c->{feeds}{$nick}{force}   = $force;
    $c->{feeds}{$nick}{dormant} = $dormant;
    $c->{feeds}{$nick}{last}    = $c->{feeds}{$nick}{last} || 0;
    $c->{feeds}{$nick}{ttl}     = $c->{feeds}{$nick}{ttl}  || 0;
    $c->write;

    return 0;
}

=head1 COPYRIGHT & LICENSE

Copyright 2005 Shawn Boyette, All Rights Reserved.

This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;
